{
 "cells": [
  {
   "cell_type": "markdown",
   "id": "modular-mozambique",
   "metadata": {},
   "source": [
    "# 习题 4.9\n",
    "\n",
    "![习题 4.9](https://tva1.sinaimg.cn/large/008i3skNly1graympx4o0j31la09k79c.jpg)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 1,
   "id": "grand-trouble",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table class=\"dataframe\">\n",
       "<caption>A data.frame: 25 × 4</caption>\n",
       "<thead>\n",
       "\t<tr><th></th><th scope=col>X1</th><th scope=col>X2</th><th scope=col>Y1</th><th scope=col>Y2</th></tr>\n",
       "\t<tr><th></th><th scope=col>&lt;int&gt;</th><th scope=col>&lt;int&gt;</th><th scope=col>&lt;int&gt;</th><th scope=col>&lt;int&gt;</th></tr>\n",
       "</thead>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>1</th><td>191</td><td>155</td><td>179</td><td>145</td></tr>\n",
       "\t<tr><th scope=row>2</th><td>195</td><td>149</td><td>201</td><td>152</td></tr>\n",
       "\t<tr><th scope=row>3</th><td>181</td><td>148</td><td>185</td><td>149</td></tr>\n",
       "\t<tr><th scope=row>4</th><td>183</td><td>153</td><td>188</td><td>149</td></tr>\n",
       "\t<tr><th scope=row>5</th><td>176</td><td>144</td><td>171</td><td>142</td></tr>\n",
       "\t<tr><th scope=row>6</th><td>208</td><td>157</td><td>192</td><td>152</td></tr>\n",
       "\t<tr><th scope=row>7</th><td>189</td><td>150</td><td>190</td><td>149</td></tr>\n",
       "\t<tr><th scope=row>8</th><td>197</td><td>159</td><td>189</td><td>152</td></tr>\n",
       "\t<tr><th scope=row>9</th><td>188</td><td>152</td><td>197</td><td>159</td></tr>\n",
       "\t<tr><th scope=row>10</th><td>192</td><td>150</td><td>187</td><td>151</td></tr>\n",
       "\t<tr><th scope=row>11</th><td>179</td><td>158</td><td>186</td><td>148</td></tr>\n",
       "\t<tr><th scope=row>12</th><td>183</td><td>147</td><td>174</td><td>147</td></tr>\n",
       "\t<tr><th scope=row>13</th><td>174</td><td>150</td><td>185</td><td>152</td></tr>\n",
       "\t<tr><th scope=row>14</th><td>190</td><td>159</td><td>195</td><td>157</td></tr>\n",
       "\t<tr><th scope=row>15</th><td>188</td><td>151</td><td>187</td><td>158</td></tr>\n",
       "\t<tr><th scope=row>16</th><td>163</td><td>137</td><td>161</td><td>130</td></tr>\n",
       "\t<tr><th scope=row>17</th><td>195</td><td>155</td><td>183</td><td>158</td></tr>\n",
       "\t<tr><th scope=row>18</th><td>186</td><td>153</td><td>173</td><td>148</td></tr>\n",
       "\t<tr><th scope=row>19</th><td>181</td><td>145</td><td>182</td><td>146</td></tr>\n",
       "\t<tr><th scope=row>20</th><td>175</td><td>140</td><td>165</td><td>137</td></tr>\n",
       "\t<tr><th scope=row>21</th><td>192</td><td>154</td><td>185</td><td>152</td></tr>\n",
       "\t<tr><th scope=row>22</th><td>174</td><td>143</td><td>178</td><td>147</td></tr>\n",
       "\t<tr><th scope=row>23</th><td>176</td><td>139</td><td>176</td><td>143</td></tr>\n",
       "\t<tr><th scope=row>24</th><td>197</td><td>167</td><td>200</td><td>158</td></tr>\n",
       "\t<tr><th scope=row>25</th><td>190</td><td>163</td><td>187</td><td>150</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "A data.frame: 25 × 4\n",
       "\\begin{tabular}{r|llll}\n",
       "  & X1 & X2 & Y1 & Y2\\\\\n",
       "  & <int> & <int> & <int> & <int>\\\\\n",
       "\\hline\n",
       "\t1 & 191 & 155 & 179 & 145\\\\\n",
       "\t2 & 195 & 149 & 201 & 152\\\\\n",
       "\t3 & 181 & 148 & 185 & 149\\\\\n",
       "\t4 & 183 & 153 & 188 & 149\\\\\n",
       "\t5 & 176 & 144 & 171 & 142\\\\\n",
       "\t6 & 208 & 157 & 192 & 152\\\\\n",
       "\t7 & 189 & 150 & 190 & 149\\\\\n",
       "\t8 & 197 & 159 & 189 & 152\\\\\n",
       "\t9 & 188 & 152 & 197 & 159\\\\\n",
       "\t10 & 192 & 150 & 187 & 151\\\\\n",
       "\t11 & 179 & 158 & 186 & 148\\\\\n",
       "\t12 & 183 & 147 & 174 & 147\\\\\n",
       "\t13 & 174 & 150 & 185 & 152\\\\\n",
       "\t14 & 190 & 159 & 195 & 157\\\\\n",
       "\t15 & 188 & 151 & 187 & 158\\\\\n",
       "\t16 & 163 & 137 & 161 & 130\\\\\n",
       "\t17 & 195 & 155 & 183 & 158\\\\\n",
       "\t18 & 186 & 153 & 173 & 148\\\\\n",
       "\t19 & 181 & 145 & 182 & 146\\\\\n",
       "\t20 & 175 & 140 & 165 & 137\\\\\n",
       "\t21 & 192 & 154 & 185 & 152\\\\\n",
       "\t22 & 174 & 143 & 178 & 147\\\\\n",
       "\t23 & 176 & 139 & 176 & 143\\\\\n",
       "\t24 & 197 & 167 & 200 & 158\\\\\n",
       "\t25 & 190 & 163 & 187 & 150\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "A data.frame: 25 × 4\n",
       "\n",
       "| <!--/--> | X1 &lt;int&gt; | X2 &lt;int&gt; | Y1 &lt;int&gt; | Y2 &lt;int&gt; |\n",
       "|---|---|---|---|---|\n",
       "| 1 | 191 | 155 | 179 | 145 |\n",
       "| 2 | 195 | 149 | 201 | 152 |\n",
       "| 3 | 181 | 148 | 185 | 149 |\n",
       "| 4 | 183 | 153 | 188 | 149 |\n",
       "| 5 | 176 | 144 | 171 | 142 |\n",
       "| 6 | 208 | 157 | 192 | 152 |\n",
       "| 7 | 189 | 150 | 190 | 149 |\n",
       "| 8 | 197 | 159 | 189 | 152 |\n",
       "| 9 | 188 | 152 | 197 | 159 |\n",
       "| 10 | 192 | 150 | 187 | 151 |\n",
       "| 11 | 179 | 158 | 186 | 148 |\n",
       "| 12 | 183 | 147 | 174 | 147 |\n",
       "| 13 | 174 | 150 | 185 | 152 |\n",
       "| 14 | 190 | 159 | 195 | 157 |\n",
       "| 15 | 188 | 151 | 187 | 158 |\n",
       "| 16 | 163 | 137 | 161 | 130 |\n",
       "| 17 | 195 | 155 | 183 | 158 |\n",
       "| 18 | 186 | 153 | 173 | 148 |\n",
       "| 19 | 181 | 145 | 182 | 146 |\n",
       "| 20 | 175 | 140 | 165 | 137 |\n",
       "| 21 | 192 | 154 | 185 | 152 |\n",
       "| 22 | 174 | 143 | 178 | 147 |\n",
       "| 23 | 176 | 139 | 176 | 143 |\n",
       "| 24 | 197 | 167 | 200 | 158 |\n",
       "| 25 | 190 | 163 | 187 | 150 |\n",
       "\n"
      ],
      "text/plain": [
       "   X1  X2  Y1  Y2 \n",
       "1  191 155 179 145\n",
       "2  195 149 201 152\n",
       "3  181 148 185 149\n",
       "4  183 153 188 149\n",
       "5  176 144 171 142\n",
       "6  208 157 192 152\n",
       "7  189 150 190 149\n",
       "8  197 159 189 152\n",
       "9  188 152 197 159\n",
       "10 192 150 187 151\n",
       "11 179 158 186 148\n",
       "12 183 147 174 147\n",
       "13 174 150 185 152\n",
       "14 190 159 195 157\n",
       "15 188 151 187 158\n",
       "16 163 137 161 130\n",
       "17 195 155 183 158\n",
       "18 186 153 173 148\n",
       "19 181 145 182 146\n",
       "20 175 140 165 137\n",
       "21 192 154 185 152\n",
       "22 174 143 178 147\n",
       "23 176 139 176 143\n",
       "24 197 167 200 158\n",
       "25 190 163 187 150"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "data <- read.table(\"ex_4_9.txt\"); data"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 2,
   "id": "silver-sister",
   "metadata": {},
   "outputs": [],
   "source": [
    "X <- data[,1:2]\n",
    "Y <- data[,3:4]"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "black-terminal",
   "metadata": {},
   "source": [
    "1. 协方差阵 $S$："
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 3,
   "id": "informal-denver",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table class=\"dataframe\">\n",
       "<caption>A matrix: 4 × 4 of type dbl</caption>\n",
       "<thead>\n",
       "\t<tr><th></th><th scope=col>X1</th><th scope=col>X2</th><th scope=col>Y1</th><th scope=col>Y2</th></tr>\n",
       "</thead>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>X1</th><td>95.29333</td><td>52.86833</td><td> 69.66167</td><td>46.11167</td></tr>\n",
       "\t<tr><th scope=row>X2</th><td>52.86833</td><td>54.36000</td><td> 51.31167</td><td>35.05333</td></tr>\n",
       "\t<tr><th scope=row>Y1</th><td>69.66167</td><td>51.31167</td><td>100.80667</td><td>56.54000</td></tr>\n",
       "\t<tr><th scope=row>Y2</th><td>46.11167</td><td>35.05333</td><td> 56.54000</td><td>45.02333</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "A matrix: 4 × 4 of type dbl\n",
       "\\begin{tabular}{r|llll}\n",
       "  & X1 & X2 & Y1 & Y2\\\\\n",
       "\\hline\n",
       "\tX1 & 95.29333 & 52.86833 &  69.66167 & 46.11167\\\\\n",
       "\tX2 & 52.86833 & 54.36000 &  51.31167 & 35.05333\\\\\n",
       "\tY1 & 69.66167 & 51.31167 & 100.80667 & 56.54000\\\\\n",
       "\tY2 & 46.11167 & 35.05333 &  56.54000 & 45.02333\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "A matrix: 4 × 4 of type dbl\n",
       "\n",
       "| <!--/--> | X1 | X2 | Y1 | Y2 |\n",
       "|---|---|---|---|---|\n",
       "| X1 | 95.29333 | 52.86833 |  69.66167 | 46.11167 |\n",
       "| X2 | 52.86833 | 54.36000 |  51.31167 | 35.05333 |\n",
       "| Y1 | 69.66167 | 51.31167 | 100.80667 | 56.54000 |\n",
       "| Y2 | 46.11167 | 35.05333 |  56.54000 | 45.02333 |\n",
       "\n"
      ],
      "text/plain": [
       "   X1       X2       Y1        Y2      \n",
       "X1 95.29333 52.86833  69.66167 46.11167\n",
       "X2 52.86833 54.36000  51.31167 35.05333\n",
       "Y1 69.66167 51.31167 100.80667 56.54000\n",
       "Y2 46.11167 35.05333  56.54000 45.02333"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "S <- cov(data); S"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "prescribed-rough",
   "metadata": {},
   "source": [
    "基于 $S$ 做典型相关分析："
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 4,
   "id": "clear-institute",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<dl>\n",
       "\t<dt>$cor</dt>\n",
       "\t\t<dd><style>\n",
       ".list-inline {list-style: none; margin:0; padding: 0}\n",
       ".list-inline>li {display: inline-block}\n",
       ".list-inline>li:not(:last-child)::after {content: \"\\00b7\"; padding: 0 .5ex}\n",
       "</style>\n",
       "<ol class=list-inline><li>0.788507916294635</li><li>0.0537397044242775</li></ol>\n",
       "</dd>\n",
       "\t<dt>$xcoef</dt>\n",
       "\t\t<dd><table class=\"dataframe\">\n",
       "<caption>A matrix: 2 × 2 of type dbl</caption>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>X1</th><td>0.01154653</td><td>-0.02857148</td></tr>\n",
       "\t<tr><th scope=row>X2</th><td>0.01443910</td><td> 0.03816093</td></tr>\n",
       "</tbody>\n",
       "</table>\n",
       "</dd>\n",
       "\t<dt>$ycoef</dt>\n",
       "\t\t<dd><table class=\"dataframe\">\n",
       "<caption>A matrix: 2 × 2 of type dbl</caption>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>Y1</th><td>0.01025573</td><td>-0.03595605</td></tr>\n",
       "\t<tr><th scope=row>Y2</th><td>0.01637533</td><td> 0.05349758</td></tr>\n",
       "</tbody>\n",
       "</table>\n",
       "</dd>\n",
       "\t<dt>$xcenter</dt>\n",
       "\t\t<dd><style>\n",
       ".dl-inline {width: auto; margin:0; padding: 0}\n",
       ".dl-inline>dt, .dl-inline>dd {float: none; width: auto; display: inline-block}\n",
       ".dl-inline>dt::after {content: \":\\0020\"; padding-right: .5ex}\n",
       ".dl-inline>dt:not(:first-of-type) {padding-left: .5ex}\n",
       "</style><dl class=dl-inline><dt>X1</dt><dd>185.72</dd><dt>X2</dt><dd>151.12</dd></dl>\n",
       "</dd>\n",
       "\t<dt>$ycenter</dt>\n",
       "\t\t<dd><style>\n",
       ".dl-inline {width: auto; margin:0; padding: 0}\n",
       ".dl-inline>dt, .dl-inline>dd {float: none; width: auto; display: inline-block}\n",
       ".dl-inline>dt::after {content: \":\\0020\"; padding-right: .5ex}\n",
       ".dl-inline>dt:not(:first-of-type) {padding-left: .5ex}\n",
       "</style><dl class=dl-inline><dt>Y1</dt><dd>183.84</dd><dt>Y2</dt><dd>149.24</dd></dl>\n",
       "</dd>\n",
       "</dl>\n"
      ],
      "text/latex": [
       "\\begin{description}\n",
       "\\item[\\$cor] \\begin{enumerate*}\n",
       "\\item 0.788507916294635\n",
       "\\item 0.0537397044242775\n",
       "\\end{enumerate*}\n",
       "\n",
       "\\item[\\$xcoef] A matrix: 2 × 2 of type dbl\n",
       "\\begin{tabular}{r|ll}\n",
       "\tX1 & 0.01154653 & -0.02857148\\\\\n",
       "\tX2 & 0.01443910 &  0.03816093\\\\\n",
       "\\end{tabular}\n",
       "\n",
       "\\item[\\$ycoef] A matrix: 2 × 2 of type dbl\n",
       "\\begin{tabular}{r|ll}\n",
       "\tY1 & 0.01025573 & -0.03595605\\\\\n",
       "\tY2 & 0.01637533 &  0.05349758\\\\\n",
       "\\end{tabular}\n",
       "\n",
       "\\item[\\$xcenter] \\begin{description*}\n",
       "\\item[X1] 185.72\n",
       "\\item[X2] 151.12\n",
       "\\end{description*}\n",
       "\n",
       "\\item[\\$ycenter] \\begin{description*}\n",
       "\\item[Y1] 183.84\n",
       "\\item[Y2] 149.24\n",
       "\\end{description*}\n",
       "\n",
       "\\end{description}\n"
      ],
      "text/markdown": [
       "$cor\n",
       ":   1. 0.788507916294635\n",
       "2. 0.0537397044242775\n",
       "\n",
       "\n",
       "\n",
       "$xcoef\n",
       ":   \n",
       "A matrix: 2 × 2 of type dbl\n",
       "\n",
       "| X1 | 0.01154653 | -0.02857148 |\n",
       "| X2 | 0.01443910 |  0.03816093 |\n",
       "\n",
       "\n",
       "$ycoef\n",
       ":   \n",
       "A matrix: 2 × 2 of type dbl\n",
       "\n",
       "| Y1 | 0.01025573 | -0.03595605 |\n",
       "| Y2 | 0.01637533 |  0.05349758 |\n",
       "\n",
       "\n",
       "$xcenter\n",
       ":   X1\n",
       ":   185.72X2\n",
       ":   151.12\n",
       "\n",
       "\n",
       "$ycenter\n",
       ":   Y1\n",
       ":   183.84Y2\n",
       ":   149.24\n",
       "\n",
       "\n",
       "\n",
       "\n"
      ],
      "text/plain": [
       "$cor\n",
       "[1] 0.7885079 0.0537397\n",
       "\n",
       "$xcoef\n",
       "         [,1]        [,2]\n",
       "X1 0.01154653 -0.02857148\n",
       "X2 0.01443910  0.03816093\n",
       "\n",
       "$ycoef\n",
       "         [,1]        [,2]\n",
       "Y1 0.01025573 -0.03595605\n",
       "Y2 0.01637533  0.05349758\n",
       "\n",
       "$xcenter\n",
       "    X1     X2 \n",
       "185.72 151.12 \n",
       "\n",
       "$ycenter\n",
       "    Y1     Y2 \n",
       "183.84 149.24 \n"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "cca.s <- cancor(X, Y); cca.s"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "remarkable-integration",
   "metadata": {},
   "source": [
    "所以有：\n",
    "\n",
    "第一对典型变量：\n",
    "\n",
    "$$\n",
    "\\begin{aligned}\n",
    "V_1 &= 0.01154653 X_1 + 0.01443910 X_2 \\\\\n",
    "W_1 &= 0.01025573 Y_1 + 0.01637533 Y_2\n",
    "\\end{aligned}\n",
    "$$\n",
    "\n",
    "第一对典型相关系数 $\\rho_1 = 0.788507916294635$.\n",
    "\n",
    "第二对典型变量：\n",
    "\n",
    "$$\n",
    "\\begin{aligned}\n",
    "V_2 &= -0.02857148 X_1 + 0.03816093 X_2 \\\\\n",
    "W_2 &= -0.03595605 Y_1 + 0.05349758 Y_2\n",
    "\\end{aligned}\n",
    "$$\n",
    "\n",
    "第二对典型相关系数 $\\rho_2 = 0.0537397044242775$."
   ]
  },
  {
   "cell_type": "markdown",
   "id": "protective-hurricane",
   "metadata": {},
   "source": [
    "2. 相关系数矩阵 $R$:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 5,
   "id": "terminal-couple",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table class=\"dataframe\">\n",
       "<caption>A matrix: 4 × 4 of type dbl</caption>\n",
       "<thead>\n",
       "\t<tr><th></th><th scope=col>X1</th><th scope=col>X2</th><th scope=col>Y1</th><th scope=col>Y2</th></tr>\n",
       "</thead>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>X1</th><td>1.0000000</td><td>0.7345555</td><td>0.7107518</td><td>0.7039807</td></tr>\n",
       "\t<tr><th scope=row>X2</th><td>0.7345555</td><td>1.0000000</td><td>0.6931573</td><td>0.7085504</td></tr>\n",
       "\t<tr><th scope=row>Y1</th><td>0.7107518</td><td>0.6931573</td><td>1.0000000</td><td>0.8392519</td></tr>\n",
       "\t<tr><th scope=row>Y2</th><td>0.7039807</td><td>0.7085504</td><td>0.8392519</td><td>1.0000000</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "A matrix: 4 × 4 of type dbl\n",
       "\\begin{tabular}{r|llll}\n",
       "  & X1 & X2 & Y1 & Y2\\\\\n",
       "\\hline\n",
       "\tX1 & 1.0000000 & 0.7345555 & 0.7107518 & 0.7039807\\\\\n",
       "\tX2 & 0.7345555 & 1.0000000 & 0.6931573 & 0.7085504\\\\\n",
       "\tY1 & 0.7107518 & 0.6931573 & 1.0000000 & 0.8392519\\\\\n",
       "\tY2 & 0.7039807 & 0.7085504 & 0.8392519 & 1.0000000\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "A matrix: 4 × 4 of type dbl\n",
       "\n",
       "| <!--/--> | X1 | X2 | Y1 | Y2 |\n",
       "|---|---|---|---|---|\n",
       "| X1 | 1.0000000 | 0.7345555 | 0.7107518 | 0.7039807 |\n",
       "| X2 | 0.7345555 | 1.0000000 | 0.6931573 | 0.7085504 |\n",
       "| Y1 | 0.7107518 | 0.6931573 | 1.0000000 | 0.8392519 |\n",
       "| Y2 | 0.7039807 | 0.7085504 | 0.8392519 | 1.0000000 |\n",
       "\n"
      ],
      "text/plain": [
       "   X1        X2        Y1        Y2       \n",
       "X1 1.0000000 0.7345555 0.7107518 0.7039807\n",
       "X2 0.7345555 1.0000000 0.6931573 0.7085504\n",
       "Y1 0.7107518 0.6931573 1.0000000 0.8392519\n",
       "Y2 0.7039807 0.7085504 0.8392519 1.0000000"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "R <- cor(data); R"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 6,
   "id": "unexpected-simple",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table class=\"dataframe\">\n",
       "<caption>A matrix: 25 × 4 of type dbl</caption>\n",
       "<thead>\n",
       "\t<tr><th></th><th scope=col>X1</th><th scope=col>X2</th><th scope=col>Y1</th><th scope=col>Y2</th></tr>\n",
       "</thead>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>1</th><td> 0.54088217</td><td> 0.52624987</td><td>-0.48205960</td><td>-0.63189808</td></tr>\n",
       "\t<tr><th scope=row>2</th><td> 0.95064139</td><td>-0.28753859</td><td> 1.70912039</td><td> 0.41132988</td></tr>\n",
       "\t<tr><th scope=row>3</th><td>-0.48351588</td><td>-0.42317000</td><td> 0.11553495</td><td>-0.03576782</td></tr>\n",
       "\t<tr><th scope=row>4</th><td>-0.27863627</td><td> 0.25498705</td><td> 0.41433222</td><td>-0.03576782</td></tr>\n",
       "\t<tr><th scope=row>5</th><td>-0.99571490</td><td>-0.96569564</td><td>-1.27885232</td><td>-1.07899577</td></tr>\n",
       "\t<tr><th scope=row>6</th><td> 2.28235884</td><td> 0.79751269</td><td> 0.81272858</td><td> 0.41132988</td></tr>\n",
       "\t<tr><th scope=row>7</th><td> 0.33600256</td><td>-0.15190718</td><td> 0.61353040</td><td>-0.03576782</td></tr>\n",
       "\t<tr><th scope=row>8</th><td> 1.15552099</td><td> 1.06877551</td><td> 0.51393131</td><td> 0.41132988</td></tr>\n",
       "\t<tr><th scope=row>9</th><td> 0.23356275</td><td> 0.11935564</td><td> 1.31072403</td><td> 1.45455784</td></tr>\n",
       "\t<tr><th scope=row>10</th><td> 0.64332197</td><td>-0.15190718</td><td> 0.31473313</td><td> 0.26229732</td></tr>\n",
       "\t<tr><th scope=row>11</th><td>-0.68839549</td><td> 0.93314410</td><td> 0.21513404</td><td>-0.18480038</td></tr>\n",
       "\t<tr><th scope=row>12</th><td>-0.27863627</td><td>-0.55880141</td><td>-0.98005505</td><td>-0.33383295</td></tr>\n",
       "\t<tr><th scope=row>13</th><td>-1.20059451</td><td>-0.15190718</td><td> 0.11553495</td><td> 0.41132988</td></tr>\n",
       "\t<tr><th scope=row>14</th><td> 0.43844236</td><td> 1.06877551</td><td> 1.11152585</td><td> 1.15649271</td></tr>\n",
       "\t<tr><th scope=row>15</th><td> 0.23356275</td><td>-0.01627577</td><td> 0.31473313</td><td> 1.30552527</td></tr>\n",
       "\t<tr><th scope=row>16</th><td>-2.32743236</td><td>-1.91511551</td><td>-2.27484323</td><td>-2.86738656</td></tr>\n",
       "\t<tr><th scope=row>17</th><td> 0.95064139</td><td> 0.52624987</td><td>-0.08366324</td><td> 1.30552527</td></tr>\n",
       "\t<tr><th scope=row>18</th><td> 0.02868315</td><td> 0.25498705</td><td>-1.07965414</td><td>-0.18480038</td></tr>\n",
       "\t<tr><th scope=row>19</th><td>-0.48351588</td><td>-0.83006423</td><td>-0.18326233</td><td>-0.48286551</td></tr>\n",
       "\t<tr><th scope=row>20</th><td>-1.09815470</td><td>-1.50822128</td><td>-1.87644687</td><td>-1.82415860</td></tr>\n",
       "\t<tr><th scope=row>21</th><td> 0.64332197</td><td> 0.39061846</td><td> 0.11553495</td><td> 0.41132988</td></tr>\n",
       "\t<tr><th scope=row>22</th><td>-1.20059451</td><td>-1.10132705</td><td>-0.58165869</td><td>-0.33383295</td></tr>\n",
       "\t<tr><th scope=row>23</th><td>-0.99571490</td><td>-1.64385269</td><td>-0.78085687</td><td>-0.92996321</td></tr>\n",
       "\t<tr><th scope=row>24</th><td> 1.15552099</td><td> 2.15382679</td><td> 1.60952130</td><td> 1.30552527</td></tr>\n",
       "\t<tr><th scope=row>25</th><td> 0.43844236</td><td> 1.61130115</td><td> 0.31473313</td><td> 0.11326475</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "A matrix: 25 × 4 of type dbl\n",
       "\\begin{tabular}{r|llll}\n",
       "  & X1 & X2 & Y1 & Y2\\\\\n",
       "\\hline\n",
       "\t1 &  0.54088217 &  0.52624987 & -0.48205960 & -0.63189808\\\\\n",
       "\t2 &  0.95064139 & -0.28753859 &  1.70912039 &  0.41132988\\\\\n",
       "\t3 & -0.48351588 & -0.42317000 &  0.11553495 & -0.03576782\\\\\n",
       "\t4 & -0.27863627 &  0.25498705 &  0.41433222 & -0.03576782\\\\\n",
       "\t5 & -0.99571490 & -0.96569564 & -1.27885232 & -1.07899577\\\\\n",
       "\t6 &  2.28235884 &  0.79751269 &  0.81272858 &  0.41132988\\\\\n",
       "\t7 &  0.33600256 & -0.15190718 &  0.61353040 & -0.03576782\\\\\n",
       "\t8 &  1.15552099 &  1.06877551 &  0.51393131 &  0.41132988\\\\\n",
       "\t9 &  0.23356275 &  0.11935564 &  1.31072403 &  1.45455784\\\\\n",
       "\t10 &  0.64332197 & -0.15190718 &  0.31473313 &  0.26229732\\\\\n",
       "\t11 & -0.68839549 &  0.93314410 &  0.21513404 & -0.18480038\\\\\n",
       "\t12 & -0.27863627 & -0.55880141 & -0.98005505 & -0.33383295\\\\\n",
       "\t13 & -1.20059451 & -0.15190718 &  0.11553495 &  0.41132988\\\\\n",
       "\t14 &  0.43844236 &  1.06877551 &  1.11152585 &  1.15649271\\\\\n",
       "\t15 &  0.23356275 & -0.01627577 &  0.31473313 &  1.30552527\\\\\n",
       "\t16 & -2.32743236 & -1.91511551 & -2.27484323 & -2.86738656\\\\\n",
       "\t17 &  0.95064139 &  0.52624987 & -0.08366324 &  1.30552527\\\\\n",
       "\t18 &  0.02868315 &  0.25498705 & -1.07965414 & -0.18480038\\\\\n",
       "\t19 & -0.48351588 & -0.83006423 & -0.18326233 & -0.48286551\\\\\n",
       "\t20 & -1.09815470 & -1.50822128 & -1.87644687 & -1.82415860\\\\\n",
       "\t21 &  0.64332197 &  0.39061846 &  0.11553495 &  0.41132988\\\\\n",
       "\t22 & -1.20059451 & -1.10132705 & -0.58165869 & -0.33383295\\\\\n",
       "\t23 & -0.99571490 & -1.64385269 & -0.78085687 & -0.92996321\\\\\n",
       "\t24 &  1.15552099 &  2.15382679 &  1.60952130 &  1.30552527\\\\\n",
       "\t25 &  0.43844236 &  1.61130115 &  0.31473313 &  0.11326475\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "A matrix: 25 × 4 of type dbl\n",
       "\n",
       "| <!--/--> | X1 | X2 | Y1 | Y2 |\n",
       "|---|---|---|---|---|\n",
       "| 1 |  0.54088217 |  0.52624987 | -0.48205960 | -0.63189808 |\n",
       "| 2 |  0.95064139 | -0.28753859 |  1.70912039 |  0.41132988 |\n",
       "| 3 | -0.48351588 | -0.42317000 |  0.11553495 | -0.03576782 |\n",
       "| 4 | -0.27863627 |  0.25498705 |  0.41433222 | -0.03576782 |\n",
       "| 5 | -0.99571490 | -0.96569564 | -1.27885232 | -1.07899577 |\n",
       "| 6 |  2.28235884 |  0.79751269 |  0.81272858 |  0.41132988 |\n",
       "| 7 |  0.33600256 | -0.15190718 |  0.61353040 | -0.03576782 |\n",
       "| 8 |  1.15552099 |  1.06877551 |  0.51393131 |  0.41132988 |\n",
       "| 9 |  0.23356275 |  0.11935564 |  1.31072403 |  1.45455784 |\n",
       "| 10 |  0.64332197 | -0.15190718 |  0.31473313 |  0.26229732 |\n",
       "| 11 | -0.68839549 |  0.93314410 |  0.21513404 | -0.18480038 |\n",
       "| 12 | -0.27863627 | -0.55880141 | -0.98005505 | -0.33383295 |\n",
       "| 13 | -1.20059451 | -0.15190718 |  0.11553495 |  0.41132988 |\n",
       "| 14 |  0.43844236 |  1.06877551 |  1.11152585 |  1.15649271 |\n",
       "| 15 |  0.23356275 | -0.01627577 |  0.31473313 |  1.30552527 |\n",
       "| 16 | -2.32743236 | -1.91511551 | -2.27484323 | -2.86738656 |\n",
       "| 17 |  0.95064139 |  0.52624987 | -0.08366324 |  1.30552527 |\n",
       "| 18 |  0.02868315 |  0.25498705 | -1.07965414 | -0.18480038 |\n",
       "| 19 | -0.48351588 | -0.83006423 | -0.18326233 | -0.48286551 |\n",
       "| 20 | -1.09815470 | -1.50822128 | -1.87644687 | -1.82415860 |\n",
       "| 21 |  0.64332197 |  0.39061846 |  0.11553495 |  0.41132988 |\n",
       "| 22 | -1.20059451 | -1.10132705 | -0.58165869 | -0.33383295 |\n",
       "| 23 | -0.99571490 | -1.64385269 | -0.78085687 | -0.92996321 |\n",
       "| 24 |  1.15552099 |  2.15382679 |  1.60952130 |  1.30552527 |\n",
       "| 25 |  0.43844236 |  1.61130115 |  0.31473313 |  0.11326475 |\n",
       "\n"
      ],
      "text/plain": [
       "   X1          X2          Y1          Y2         \n",
       "1   0.54088217  0.52624987 -0.48205960 -0.63189808\n",
       "2   0.95064139 -0.28753859  1.70912039  0.41132988\n",
       "3  -0.48351588 -0.42317000  0.11553495 -0.03576782\n",
       "4  -0.27863627  0.25498705  0.41433222 -0.03576782\n",
       "5  -0.99571490 -0.96569564 -1.27885232 -1.07899577\n",
       "6   2.28235884  0.79751269  0.81272858  0.41132988\n",
       "7   0.33600256 -0.15190718  0.61353040 -0.03576782\n",
       "8   1.15552099  1.06877551  0.51393131  0.41132988\n",
       "9   0.23356275  0.11935564  1.31072403  1.45455784\n",
       "10  0.64332197 -0.15190718  0.31473313  0.26229732\n",
       "11 -0.68839549  0.93314410  0.21513404 -0.18480038\n",
       "12 -0.27863627 -0.55880141 -0.98005505 -0.33383295\n",
       "13 -1.20059451 -0.15190718  0.11553495  0.41132988\n",
       "14  0.43844236  1.06877551  1.11152585  1.15649271\n",
       "15  0.23356275 -0.01627577  0.31473313  1.30552527\n",
       "16 -2.32743236 -1.91511551 -2.27484323 -2.86738656\n",
       "17  0.95064139  0.52624987 -0.08366324  1.30552527\n",
       "18  0.02868315  0.25498705 -1.07965414 -0.18480038\n",
       "19 -0.48351588 -0.83006423 -0.18326233 -0.48286551\n",
       "20 -1.09815470 -1.50822128 -1.87644687 -1.82415860\n",
       "21  0.64332197  0.39061846  0.11553495  0.41132988\n",
       "22 -1.20059451 -1.10132705 -0.58165869 -0.33383295\n",
       "23 -0.99571490 -1.64385269 -0.78085687 -0.92996321\n",
       "24  1.15552099  2.15382679  1.60952130  1.30552527\n",
       "25  0.43844236  1.61130115  0.31473313  0.11326475"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "data.scale <- scale(data)\n",
    "data.scale.X <- data.scale[,1:2]\n",
    "data.scale.Y <- data.scale[,3:4]\n",
    "data.scale"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "precious-greece",
   "metadata": {},
   "source": [
    "基于 $R$ 做典型相关分析："
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 7,
   "id": "suffering-analyst",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<dl>\n",
       "\t<dt>$cor</dt>\n",
       "\t\t<dd><style>\n",
       ".list-inline {list-style: none; margin:0; padding: 0}\n",
       ".list-inline>li {display: inline-block}\n",
       ".list-inline>li:not(:last-child)::after {content: \"\\00b7\"; padding: 0 .5ex}\n",
       "</style>\n",
       "<ol class=list-inline><li>0.788507916294635</li><li>0.0537397044242769</li></ol>\n",
       "</dd>\n",
       "\t<dt>$xcoef</dt>\n",
       "\t\t<dd><table class=\"dataframe\">\n",
       "<caption>A matrix: 2 × 2 of type dbl</caption>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>X1</th><td>0.1127152</td><td>-0.2789099</td></tr>\n",
       "\t<tr><th scope=row>X2</th><td>0.1064583</td><td> 0.2813576</td></tr>\n",
       "</tbody>\n",
       "</table>\n",
       "</dd>\n",
       "\t<dt>$ycoef</dt>\n",
       "\t\t<dd><table class=\"dataframe\">\n",
       "<caption>A matrix: 2 × 2 of type dbl</caption>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>Y1</th><td>0.1029701</td><td>-0.3610078</td></tr>\n",
       "\t<tr><th scope=row>Y2</th><td>0.1098775</td><td> 0.3589657</td></tr>\n",
       "</tbody>\n",
       "</table>\n",
       "</dd>\n",
       "\t<dt>$xcenter</dt>\n",
       "\t\t<dd><style>\n",
       ".dl-inline {width: auto; margin:0; padding: 0}\n",
       ".dl-inline>dt, .dl-inline>dd {float: none; width: auto; display: inline-block}\n",
       ".dl-inline>dt::after {content: \":\\0020\"; padding-right: .5ex}\n",
       ".dl-inline>dt:not(:first-of-type) {padding-left: .5ex}\n",
       "</style><dl class=dl-inline><dt>X1</dt><dd>1.24344978758018e-16</dd><dt>X2</dt><dd>-6.04932770542632e-16</dd></dl>\n",
       "</dd>\n",
       "\t<dt>$ycenter</dt>\n",
       "\t\t<dd><style>\n",
       ".dl-inline {width: auto; margin:0; padding: 0}\n",
       ".dl-inline>dt, .dl-inline>dd {float: none; width: auto; display: inline-block}\n",
       ".dl-inline>dt::after {content: \":\\0020\"; padding-right: .5ex}\n",
       ".dl-inline>dt:not(:first-of-type) {padding-left: .5ex}\n",
       "</style><dl class=dl-inline><dt>Y1</dt><dd>-3.3806291099836e-16</dd><dt>Y2</dt><dd>-1.35974564940966e-15</dd></dl>\n",
       "</dd>\n",
       "</dl>\n"
      ],
      "text/latex": [
       "\\begin{description}\n",
       "\\item[\\$cor] \\begin{enumerate*}\n",
       "\\item 0.788507916294635\n",
       "\\item 0.0537397044242769\n",
       "\\end{enumerate*}\n",
       "\n",
       "\\item[\\$xcoef] A matrix: 2 × 2 of type dbl\n",
       "\\begin{tabular}{r|ll}\n",
       "\tX1 & 0.1127152 & -0.2789099\\\\\n",
       "\tX2 & 0.1064583 &  0.2813576\\\\\n",
       "\\end{tabular}\n",
       "\n",
       "\\item[\\$ycoef] A matrix: 2 × 2 of type dbl\n",
       "\\begin{tabular}{r|ll}\n",
       "\tY1 & 0.1029701 & -0.3610078\\\\\n",
       "\tY2 & 0.1098775 &  0.3589657\\\\\n",
       "\\end{tabular}\n",
       "\n",
       "\\item[\\$xcenter] \\begin{description*}\n",
       "\\item[X1] 1.24344978758018e-16\n",
       "\\item[X2] -6.04932770542632e-16\n",
       "\\end{description*}\n",
       "\n",
       "\\item[\\$ycenter] \\begin{description*}\n",
       "\\item[Y1] -3.3806291099836e-16\n",
       "\\item[Y2] -1.35974564940966e-15\n",
       "\\end{description*}\n",
       "\n",
       "\\end{description}\n"
      ],
      "text/markdown": [
       "$cor\n",
       ":   1. 0.788507916294635\n",
       "2. 0.0537397044242769\n",
       "\n",
       "\n",
       "\n",
       "$xcoef\n",
       ":   \n",
       "A matrix: 2 × 2 of type dbl\n",
       "\n",
       "| X1 | 0.1127152 | -0.2789099 |\n",
       "| X2 | 0.1064583 |  0.2813576 |\n",
       "\n",
       "\n",
       "$ycoef\n",
       ":   \n",
       "A matrix: 2 × 2 of type dbl\n",
       "\n",
       "| Y1 | 0.1029701 | -0.3610078 |\n",
       "| Y2 | 0.1098775 |  0.3589657 |\n",
       "\n",
       "\n",
       "$xcenter\n",
       ":   X1\n",
       ":   1.24344978758018e-16X2\n",
       ":   -6.04932770542632e-16\n",
       "\n",
       "\n",
       "$ycenter\n",
       ":   Y1\n",
       ":   -3.3806291099836e-16Y2\n",
       ":   -1.35974564940966e-15\n",
       "\n",
       "\n",
       "\n",
       "\n"
      ],
      "text/plain": [
       "$cor\n",
       "[1] 0.7885079 0.0537397\n",
       "\n",
       "$xcoef\n",
       "        [,1]       [,2]\n",
       "X1 0.1127152 -0.2789099\n",
       "X2 0.1064583  0.2813576\n",
       "\n",
       "$ycoef\n",
       "        [,1]       [,2]\n",
       "Y1 0.1029701 -0.3610078\n",
       "Y2 0.1098775  0.3589657\n",
       "\n",
       "$xcenter\n",
       "           X1            X2 \n",
       " 1.243450e-16 -6.049328e-16 \n",
       "\n",
       "$ycenter\n",
       "           Y1            Y2 \n",
       "-3.380629e-16 -1.359746e-15 \n"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "cca.r <- cancor(data.scale.X, data.scale.Y); cca.r"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "fatty-blackberry",
   "metadata": {},
   "source": [
    "得到：\n",
    "\n",
    "第一对典型变量：\n",
    "\n",
    "$$\n",
    "\\begin{aligned}\n",
    "V_1^* &= 0.1127152 X_1^* + 0.1064583 X_2^* \\\\\n",
    "W_1^* &= 0.1029701 Y_1^* + 0.1098775 Y_2^*\n",
    "\\end{aligned}\n",
    "$$\n",
    "\n",
    "第一对典型相关系数 $\\rho_1 = 0.788507916294635$.\n",
    "\n",
    "第二对典型变量：\n",
    "\n",
    "$$\n",
    "\\begin{aligned}\n",
    "V_2^* &= -0.2789099 X_1^* + 0.2813576 X_2^* \\\\\n",
    "W_2^* &= -0.3610078 Y_1^* + 0.3589657 Y_2^*\n",
    "\\end{aligned}\n",
    "$$\n",
    "\n",
    "第二对典型相关系数 $\\rho_2 = 0.0537397044242769$.\n",
    "\n",
    "由于样本数据同量纲，所以从协方差阵和相关系数矩阵进行典型相关分析，得到的结果是一样的。"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "utility-wellington",
   "metadata": {},
   "source": [
    "3. 对典型变量进行显著性检验"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "sublime-nylon",
   "metadata": {},
   "source": [
    "这里需要自己编写函数实现 （ref: https://blog.csdn.net/Tiaaaaa/article/details/58137522 , https://rstudio-pubs-static.s3.amazonaws.com/553282_c1046a4c0b1a40ac9319f51b6207a9d7.html ）："
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 8,
   "id": "normal-second",
   "metadata": {},
   "outputs": [],
   "source": [
    "corcoef.test <- function(cor, n, p, q) {\n",
    "    # 相关系数检验\n",
    "    # Args:\n",
    "    #   r: 典型相关系数\n",
    "    #   n: 样本个数 (n > p + q)\n",
    "    #   p, q: 向量的维数\n",
    "    # Returns:\n",
    "    #   显著性检验表格\n",
    "    \n",
    "    ev <- cor^2\n",
    "    ev2 <- 1 - ev\n",
    "    \n",
    "    l <- length(ev)\n",
    "    m <- n - 1 - (p+q+1) / 2\n",
    "    w <- cbind(NULL)  # 保存中间计算值\n",
    "\n",
    "    for (i in 1:l) {\n",
    "      w <- cbind(w,prod(ev2[i:l]))\n",
    "    }\n",
    "\n",
    "    Q <- c(NULL); d <- c(NULL)\n",
    "    for (i in 1:l){\n",
    "      Q <- cbind(Q, -(m-(i-1)) * log(w[i]))\n",
    "      d <- cbind(d, (p-i+1) * (q-i+1))\n",
    "    }\n",
    "\n",
    "    pvalue <- pchisq(Q, d, lower.tail=FALSE)    # 计算卡方统计量对应的概率\n",
    "    \n",
    "    bat <- cbind(t(Q), t(d), t(pvalue))\n",
    "    colnames(bat) <- c(\"Chi-Squared\", \"df\", \"pvalue\")\n",
    "    rownames(bat) <- 1:l\n",
    "    \n",
    "    bat    # ret\n",
    "}"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 9,
   "id": "headed-launch",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table class=\"dataframe\">\n",
       "<caption>A matrix: 2 × 3 of type dbl</caption>\n",
       "<thead>\n",
       "\t<tr><th></th><th scope=col>Chi-Squared</th><th scope=col>df</th><th scope=col>pvalue</th></tr>\n",
       "</thead>\n",
       "<tbody>\n",
       "\t<tr><th scope=row>1</th><td>20.96417998</td><td>4</td><td>0.0003218897</td></tr>\n",
       "\t<tr><th scope=row>2</th><td> 0.05928875</td><td>1</td><td>0.8076236560</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "A matrix: 2 × 3 of type dbl\n",
       "\\begin{tabular}{r|lll}\n",
       "  & Chi-Squared & df & pvalue\\\\\n",
       "\\hline\n",
       "\t1 & 20.96417998 & 4 & 0.0003218897\\\\\n",
       "\t2 &  0.05928875 & 1 & 0.8076236560\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "A matrix: 2 × 3 of type dbl\n",
       "\n",
       "| <!--/--> | Chi-Squared | df | pvalue |\n",
       "|---|---|---|---|\n",
       "| 1 | 20.96417998 | 4 | 0.0003218897 |\n",
       "| 2 |  0.05928875 | 1 | 0.8076236560 |\n",
       "\n"
      ],
      "text/plain": [
       "  Chi-Squared df pvalue      \n",
       "1 20.96417998 4  0.0003218897\n",
       "2  0.05928875 1  0.8076236560"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "corcoef.test(cca.r$cor, n=25, p=2, q=2)"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "revolutionary-curtis",
   "metadata": {},
   "source": [
    "取显著水平为 $\\alpha=0.05$，其中第一对典型变量的检验 $p$ 值为 $0.003<0.05$，认为第一对典型变量显著相关，\n",
    "而第二对典型变量的检验 $p$ 值为 $0.8031>0.05$，认为第二对典型变量不是显著相关。"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "codemirror_mode": "r",
   "file_extension": ".r",
   "mimetype": "text/x-r-source",
   "name": "R",
   "pygments_lexer": "r",
   "version": "4.0.4"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 5
}
